HPAVC/HPAVC CD-ROM.iso/pc/SPX30.ZIP/DEMO09.ZIP/DEMO09.PAS

Pascal/Delphi Source File | 1994-06-13 | 5.0 KB | 188 lines

Program Demo9;

{ SPX library - Geomorph HexMap demo Copyright 1993 Scott D. Ramsay  }

Uses crt,spx_vga,spx_vsp,spx_fnc,spx_sfn,spx_geo,spx_key;

const
  path = '';      { default path for files }
  gmx  = 50;      { geomorph width }
  gmy  = 50;      { geomorph height }
  sp   = 6;       { scroll speed }

type
  ThexPos     = record
                  hexcol,hexrow : byte;
                end;
  PMyHexMorph = ^TMyHexMorph;
  TMyHexMorph = object(THexMorph)
                  function geomap(x,y:integer):integer;virtual;
                  procedure placegeo(x,y,geonum,cx,cy:integer);virtual;
                  procedure nogogeo(x,y,cx,cy:integer);virtual;
                end;

var
  hexes : array[0..7] of pointer;               { hold loaded sprites }
  vx,vy,                                        { object's pixel position }
  hcx,hcy : integer;                            { current drawn hex map pos }
  map   : array[0..gmy-1,0..gmx-1] of byte;     { hex map - geomorph }
  mm    : PMyHexMorph;
  h1,                                           { object's hex coordinates }
  h2    : THexPos;                              { random target coord }

{ Create a random geomorph }
procedure createmap;
var
  d,e : integer;
begin
  for d := 0 to gmy-1 do
    for e := 0 to gmx-1 do
      map[d,e] := random(5)+2; { use only sprites 2..6 }
end;

{ draw the screen }
procedure drawscreen;
begin
  rectangle(9,9,161,161,4);
  putletter(180,20,15,'Hex Map test');
  putletter(180,60,9,'USE ARROW KEYS TO SCROLL MAP');
  putletter(180,67,9,'PRESS ESC TO QUIT');
  putletter(10,165,4,'Object position:');
  putletter(10,172,4,'Target position:');
  putletter(SFNx,172,12,st(h2.hexcol)+','+st(h2.hexrow));
end;


{ Set variables and screen }
procedure setup;
begin
  openmode(1);                      { open vga 320x200x256 mode }
  randomize;                        { set random seed }
  loadvsp(path+'hex2.vsp',hexes);   { load sprites }
  createmap;                        { create map }
  mm := new(PMyHexMorph,init(gmx,gmy,13,12,14,14,0,0)); { init HexMap }
 { The Y position of the odd columns will be offset by 6.  The }
 { first column is even (0) }
  mm^.oddy := 6;
  vx := 0; vy := 0;      { Set objects starting position }
  h2.hexcol := random(gmx);     { Set random object position }
  h2.hexrow := random(gmy);
  drawscreen;            { Draw screen }
end;


{ Get keyboard input }
procedure getinput;
var
  ox,oy : integer;
begin
  ox := h1.hexcol; oy := h2.hexrow; { save old object position }
  if (np[7,2] or np[8,2] or np[9,2])
    then dec(vy,sp) { move up }
    else
      if (np[1,2] or np[2,2] or np[3,2])
        then inc(vy,sp); { move down }
  if (np[7,2] or np[4,2] or np[1,2])
    then dec(vx,sp) { move left }
    else
      if (np[9,2] or np[6,2] or np[3,2])
        then inc(vx,sp); { move right }
 { make sure VX,VY is always in the legal ranges }
  ifix(vx,0,gmx*mm^.gsx-1);
  ifix(vy,0,gmy*mm^.gsy-1);
 { Calcuate the actual tile location }
  h1.hexcol := vx div mm^.gsx; h1.hexrow := vy div mm^.gsy;
 { print stats on screen }
  if (h1.hexcol<>ox) or (h1.hexrow<>oy)
    then
      begin
        bar(69,165,100,170,0);
        putletter(69,165,12,st(h1.hexcol)+','+st(h1.hexrow));
      end;
end;


{ program loop }
procedure ani;
begin
  repeat
    getinput;                 { get keyboard input }
    mm^.drawmap(vx,vy);       { draw the map }
  until key[KEY_ESC];         { Press ESC to quit }
end;


{ Set the screen clipping region on or off }
procedure hexSetClip(on:boolean);
begin
  if on
    then
      begin
        WinMinX := 10; WinMinY := 10;
        WinMaxX := 160; WinMaxY := 160;
      end
    else
      begin
        WinMinX := 0; WinMinY := 0;
        WinMaxX := 320; WinMaxY := 200;
      end;
end;

(**) { TMyHexMorph }

function TMyHexMorph.geomap(x,y:integer):integer;
begin
  geomap := map[y,x];
  hcx := x; hcy := y;
end;


procedure TMyHexMorph.nogogeo(x,y,cx,cy:integer);
begin
  hexSetClip(true);
  ftput_clip(x,y,hexes[0]^,false);
  hexSetClip(false);
end;


procedure TMyHexMorph.placegeo(x,y,geonum,cx,cy:integer);
begin
  if geonum>0
    then
      begin
      { display the tiles, display the object if its on this tile }
        hexSetClip(true);
        if (h1.hexcol=hcx) and (h1.hexrow=hcy)
          then ftput_clip(x,y,hexes[6]^,false)
          else
        if (h2.hexcol=hcx) and (h2.hexrow=hcy)
          then ftput_clip(x,y,hexes[7]^,false)
          else ftput_clip(x,y,hexes[geonum-1]^,false);
        hexSetClip(false);
      end;
end;


procedure showit;
begin
  clrscr;
  writeln('SPX library - Geomorph demo 2 - HexMap ');
  writeln('Copyright 1993 Scott D. Ramsay');
  writeln;
  writeln('Keys:');
  writeln(' ESC          - quit demo');
  writeln(' Arrow keys   - move object');
  writeln;
  write('Press SPACE to continue.');
  clearbuffer;
  repeat until key[KEY_SPACE];
end;


begin
  showit;
  setup;
  ani;
  closemode;
end.